.TITLE	ERSUB
	.IDENT   /02.10/

;
; Copyright (c) 1995 by Mentec, Inc., U.S.A.
; All rights reserved
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;
; P. J. BEZEREDI 16-NOV-81
;
;
;
; J. R. KAUFFMAN
; C. PUTNAM
; S. C. ADAMS
; G. MARIGOWDA
;
; 
; MODIFIED BY:
;
; G. MARIGOWDA 		14-JUL-86
;	   CHANGE THE STACK OFFSET TO ACCESS APR5 MAPPING   V02.06
;
; D. Carroll	16-Jan-1996		02.10
;	DC430 - Don't zero X.CYLC except on seek optimized devices
;
;
;
; ERROR LOGGING SUBROUTINES
;

;
; MACRO LIBRARY CALLS
;
	.MCALL	CLKDF$,EPKDF$,F11DF$,HDRDF$,HWDDF$,PKTDF$,UCBDF$
	.MCALL	BGCK$A
	CLKDF$			;DEFINE CLOCK QUEUE OFFSETS
	EPKDF$			;DEFINE ERROR PACKET OFFSETS
	F11DF$			;DEFINE FILES-11 OFFSETS
	HDRDF$			;DEFINE TASK HEADER OFFSETS
	HWDDF$			;DEFINE CPU REGISTERS
	PKTDF$			;DEFINE I/O PACKET OFFSETS
	UCBDF$			;DEFINE UCB OFFSETS

;
; EQUATED SYMBOLS
;

ERRTIM=	H$$RTZ*2		;2 SECONDS
IOC=	X.IOC+140000		;I/O COUNT
ERHL=	X.ERHL+140000		;HARD ERROR LIMIT
ERSL=	X.ERSL+140000		;SOFT ERROR LIMIT
ERSC=	X.ERSC+140000		;SOFT ERROR COUNT
ERHC=	X.ERHC+140000		;HARD ERROR COUNT
ASSUME	ERSC, IOC+6		;ORDERING IS IMPORTANT
ASSUME	X.WCNT, X.IOC+10	;WORDS TRANSFERED COUNT
ASSUME	X.CYLC, X.IOC+14	;CYLINDERS CROSSED COUNT
ASSUME	V.PKSR, V.LABL+12.	;PACK SERIAL NUMBER



	.IF DF	E$$LOG

;+
; **-$DVER1-LOG A DEVICE ERROR
;
; THIS ROUTINE IS CALLED TO LOG A DEVICE ERROR.  AN ERROR LOG PACKET
; WILL BE ALLOCATED AND THE CONTEXT OF THE CURRENT TRANSFER WILL BE
; SAVED.  IF AN ERROR IS ALREADY IN PROGRESS FOR THIS DEVICE, THE ERROR
; WILL BE IGNORED.  INFORMATION CONCERNING ALL ACTIVE DEVICES WILL ALSO
; BE SAVED.
;
; THE ERROR CODE IS SETUP TO MARK THIS AS A HARD DEVICE ERROR.  IF THE
; OPERATION IS SUCCESSFUL, THE CODE WILL BE CHANGED TO A SOFT DEVICE
; ERROR WHEN THE I/O OPERATION IS TERMINATED.
;
; INPUTS:
;
;	R2=ADDRESS OF THE BLOCK OF REGISTERS TO LOG (MUST BE THE
;	   CSR ADDRESS IF KS.MBC IS SET)
;	R4=SCB ADDRESS
;	R5=UCB ADDRESS
;
; OUTPUTS:
;
;	IF THIS IS THE FIRST OCCURENCE OF THE ERROR, THE ERROR LOG
;	PACKET IS FILED AND THE SCB IS SET TO POINT TO THE PACKET
;	ADDRESS AND THE ERROR IN PROGRESS BIT IS SET.
;
; NOTE: ALL REGISTERS ARE PRESERVED.
;-
	.ENABL	LSB

	.IFTF	; DF E$$LOG

$DVER1::			;LOG DEVICE ERROR

	.IFT	; DF E$$LOG

	MOV	R0,-(SP)	;SAVE REGISTER
	MOV	#E$CERR+<400*E$SDVH>,R0  ;GET THE HARD ERROR CODE
	BR	10$		;JOIN COMMON PROCESSING CODE

	.IFTF	; DF E$$LOG

$DVTM2::

	.IFT	; DF E$$LOG

	MOV	R0,-(SP)	;SAVE REGISTER
	MOV	#E$CERR+<400*E$STMO>,R0 ;SET UP THE ERROR LOG PACKET FOR...
				;... A DEVICE TIMEOUT ERROR

10$:	CALL	LOGTST		;CAN WE LOG THE ERROR?
	BCS	50$		;IF CS NO
	MOV	R1,-(SP)	;SAVE REGISTERS
	MOV	R2,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	#SM.HDR!SM.DID!SM.DOP!SM.DAT!SM.DAC,R2  ;SET FLAGS ...
				;... HEADER SUBPACKET, DEVICE ID, ...
				;... DEVICE OPERATION, DATA, ACTIVITY
	MOVB	S.RCNT(R4),R1	;GET THE NUMBER OF REGISTERS TO SAVE
	ASL	R1		;CONVERT IT INTO A NUMBER OF BYTES
	MOV	S.KRB(R4),R3	;GET CURRENT KRB ADDRESS
	BIT	#KS.MBC,K.STS(R3)  ;BAE REGISTERS PRESENT?
	BEQ	30$		;IF EQ NO
	ADD	#4,R1		;YES, ADD SPACE FOR 2 MORE REGISTERS
	BIS	#SM.MBC,R2	;FLAG IT FOR LATER
30$:	MOVB	S.ROFF(R4),R3	;GET THE OFFSET TO THE FIRST REGISTER
	ADD	2(SP),R3	;COMPUTE ACTUAL START OF REGISTERS

;
; AT THIS POINT THE REGISTERS ARE:
;
;	R0 = ENTRY TYPE CODE AND SUBTYPE CODE
;	R1 = LENGTH OF DEVICE REGISTERS IN BYTES
;	R2 = CONTROL MASK WORD
;	R3 = BEGINNING ADDRESS OF DEVICE REGISTERS
;	R4 = SCB ADDRESS
;	R5 = UCB ADDRESS
;

	MOV	KISAR6,-(SP)	; SAVE MAPPING
	CALL	$CRPK1		;CREATE THE PACKET
	BCS	45$		;IF CS FAILURE
	CMP	R0,#E$CERR+<400*E$STMO>  ;IS THIS A TIMEOUT ERROR?
	BNE	40$		;IF NE NO
	MOVB	S.ROFF(R4),R2	;GET OFFSET TO FIRST REGISTER
	ASL	R2		;CONVERT IT TO BYTES
	SUB	R2,R1		;COMPUTE ADDRESS TO STORE CSR CONTENTS
	MOV	$DVSAV,(R1)	;PUT SAVED CSR CONTENTS IN SUBPACKET
40$:	MOV	R3,S.EMB(R4)	;SAVE THE ERROR LOG PACKET ADDRESS
45$:	MOV	(SP)+,KISAR6	; RESTORE APR6 MAPPING
	MOV	(SP)+,R3	; RESTORE REGISTERS
	MOV	(SP)+,R2	;
	MOV	(SP)+,R1	;
50$:	MOV	(SP)+,R0	;

	.ENDC	; DF E$$LOG


	BIS	#S2.EIP,S.ST2(R4)  ;INDICATE ERROR IN PROGRESS
	CLC			;INDICATE NO UMD FUNCTION
	RETURN			;

	.DSABL	LSB

;+
; **-$LGER1-LOG AN ERROR LOG PACKET (NO ERROR NEED BE PRESENT)
;
; THIS ROUTINE IS CALLED BY DRIVERS THAT WISH TO CREATE AN ERROR LOG
; PACKET WHEN NO ERROR IS PRESENT, I.E. FOR AN UNSOLICITED INTERRUPT.
; THE PACKET WILL BE CREATED AND THE DRIVER IS RESPONSIBLE FOR FILLING
; IN THE NECESSARY DATA INFORMATION.
;
; INPUTS:
;
;	R1=LENGTH OF DATA TO BE LOGGED IN BYTES
;	R4=SCB ADDRESS (IF ZERO THEN NO I/O PACKET IS PRESENT)
;	R5=UCB ADDRESS
;
; OUTPUTS:
;
;	C=1 IF ERROR CANNOT BE LOGGED FOR ANY REASON
;	C=0 IF ERROR CAN BE LOGGED
;		R1=ADDRESS OF DATA AREA IN ERROR LOG PACKET
;		R3=ADDRESS OF ERROR LOG PACKET
;
;	R4 AND R5 ARE PRESERVED
;	R0, R2 AND R3 ARE DESTROYED
;	APR6 MAPPING DESTROYED: KISAR6 MAPS PACKET
;-


	.IF DF	E$$LOG

$LGER1::CALL	LOGTST		;CAN WE LOG THE ERROR
	BCS	20$		;IF CS NO
	MOV	#E$CDVI+<400*E$SDVI>,R0  ;ASSUME DEVICE INFORMATION
	MOV	#SM.HDR!SM.DID!SM.DAT!SM.DAC,R2  ;SET FLAGS
	TST	R4		;DO WE HAVE AN SCB ADDRESS?
	BEQ	10$		;IF EQ NO
	BIS	#SM.DOP,R2	;YES, LOG I/O PACKET INFORMATION
	MOV	#E$CERR+<400*E$SDVH>,R0  ;SET HARD ERROR
10$:	CLR	R3		;DO NOT FILL DATA SUBPACKET AREA
	CALL	$CRPK1		;CREATE THE ERROR LOG PACKET
	BCS	20$		;IF CS FAILURE
	TST	R4		;DO SE HAVE AN SCB ADDRESS? (C=0)
	BEQ	20$		;IF EQ NO
	MOV	R3,S.EMB(R4)	;SAVE ERROR LOG PACKET ADDRESS
	BIS	#S2.EIP,S.ST2(R4)  ;SET ERROR IN PROGRESS
20$:	RETURN			;

;+
; **-LOGTST-SEE IF WE CAN LOG AN ERROR
;
; THIS ROUTINE WILL CHECK TO SEE IF THE ERROR CANNOT BE LOGGED. IF
; LOGGING IS OFF, OR IF THERE IS ALREADY AN ERROR IN PROGRESS, OR
; IF BOTH LIMITS HAVE BEEN REACHED, THE PACKET WILL BE REJECTED HERE
; INSTEAD OF LATER IN $FERL1 THE ERROR SEQUENCE NUMBER IS INCREMENTED
; IF LOGGING IS ON AND THERE IS NOT ALREADY AN ERROR IN PROGRESS.
;
; INPUTS:
;
;	R4=SCB ADDRESS OF ZERO IF NO SCB
;	R5=UCB ADDRESS
;
; OUTPUTS:
;
;	C=0 IF ERROR CAN POTENTIALLY BE LOGGED
;	C=1 IF ERROR CANNOT BE LOGGED
;-

LOGTST:	MOV	KISAR6,-(SP)	;SAVE APR6 MAPPING
	BIT	#ES.LOG,$ERFLA	;IS ERROR LOGGING TURNED ON?
	BEQ	20$		;IF EQ NO
	TST	R4		;SCB PRESENT?
	BEQ	5$		;IF EQ NO
	BIT	#S2.EIP!S2.ENB,S.ST2(R4)  ;ERROR IN PROGRESS/LOGGING OFF?
	BNE	20$		;IF NE YES
5$:	INC	$ERRSQ		;COUNT THE ERROR
	BITB	#ES.LIM,$ERFLA	;IS LIMITING ENABLED?
	BEQ	10$		;IF EQ NO
	MOV	U.UCBX(R5),KISAR6  ;MAP UCB EXTENSION IN SECONDARY POOL
	BEQ	10$		;IF EQ NO EXTENSION
	CMPB	ERHC,ERHL	;IS THE HARD THRESHOLD EXCEEDED?
	BLO	10$		;IF LO NO
	CMPB	ERSC,ERSL	;IS THE SOFT THRESHOLD EXCEEDED?
	BHIS	20$		;IF HIS YES
10$:	TST	R4		;DO WE HAVE AN SCB?
	BEQ	30$		;IF EQ NO
	CLR	S.EMB(R4)	;INDICATE NO PACKET JUST YET
	BR	30$		;
20$:	SEC			;CANNOT LOG THE ERROR
30$:	MOV	(SP)+,KISAR6	;RESTORE APR6 MAPPING
	RETURN			;

	.ENDC	; DF E$$LOG


;+
; **-$FERL1-FINISH ERROR LOGGING PROCESS
;
; THIS ROUTINE IS CALLED AT I/O DONE TIME OR WHEN IT IS NECESSARY
; TO QUEUE AN ERROR LOG PACKET AFTER A SUCCESSFUL RECOVERY OF A
; MID-TRANSFER ERROR.
;
; INPUTS:
;	R0=FIRST I/O STATUS WORD
;	R2=STARTING AND FINAL ERROR RETRY COUNTS
;	R3=ERROR LOG PACKET APR BIAS IF R4=0
;	R4=SCB ADDRESS OR ZERO
;	R5=UCB ADDRESS
;
; OUTPUTS:
;	THE ERROR PACKET IS QUEUED TO THE ERROR LOGGER.
;	THE ERROR IN PROGRESS BIT IS CLEARED.
;
; R1 AND R2 ARE DESTROYED.
;-

$FERL1::			;FINISH ERROR LOGGING PROCESS


	.IF DF	E$$LOG

	MOV	KISAR6,-(SP)	; SAVE MAPPING
	MOV	R3,-(SP)	;SAVE REGISTER
	TST	R4		;DO WE HAVE AN SCB?
	BEQ	5$		;IF EQ NO, R3 HAS PACKET ADDRESS
	MOV	S.EMB(R4),R3	;GET ADDRESS OF ERROR LOG PACKET
	BEQ	40$		;IF EQ NO PACKET
5$:	MOV	R0,-(SP)	;SAVE REGISTER
	MOV	R3,KISAR6	; MAP TO PACKET
	MOV	@#140004+E$HSBF,R1 ; GET SUBPACKET MASK WORD
	MOV	R4,-(SP)	;SAVE R4
	ROR	R1		;HEADER SUBPACKET IS ALWAYS PRESENT
	MOV	#E$HLEN+4,R4	;ACCOUNT FOR THE LINK WORD, THE LENGTH WORD
				;...AND THE HEADER SUBPACKET LENGTH
	ROR	R1		;IS THE TASK SUBPACKET PRESENT?
	BCC	6$		;IF CC - NOT PRESENT
	ADD	#E$TLEN,R4	;ACCOUNT FOR THE TASK SUBPACKET LENGTH
6$:	ROR	R1		;IS THE DEVICE ID SUBPACKET PRESENT?
	BCC	7$		;IF CC - NOT PRESENT
	ADD	#E$ILEN,R4	;ACCOUNT FOR THE DEVICE ID SUBPACKET LENGTH
7$:	ROR	R1		;IS THE DEVICE OPERATION SUBPACKET PRESENT?
	BCC	8$		;IF CC - NOT PRESENT
	ADD	#E$ORTY,R4	;GET TO THE "RETRY COUNTS" OFFSET
				;...IN THE DEVICE OPERATION SUBPACKET
	ADD	#140000,R4	; POINT R4 TO RETRY COUNTS
	MOV	R2,(R4)		;...AND INSERT THE RETRY COUNTS
8$:	MOV	(SP)+,R4	;RESTORE R4
	TST	R2		;ANY RETRY COUNTS?
	BEQ	30$		; IF EQ DO NOT UPDATE COUNTS
	MOV	U.UCBX(R5),KISAR6  ;MAP UCB EXTENSION IN SECONDARY POOL
	BEQ	30$		;IF EQ NO EXTENSION
	MOV	#ERHC,R2	;POINT TO HARD ERROR COUNT
	TSTB	R0		;SUCCESSFUL FUNCTION?
	BMI	10$		;IF MI NO

	MOV	#ERSC,R2	;POINT TO SOFT ERROR COUNT
10$:
	BITB	#ES.LIM,$ERFLA	; IS LIMITING ENABLED?
	BEQ	25$		; IF EQ NO, DON'T TEST LIMITS OR UPDATE COUNT
	CMPB	(R2),-2(R2)	;IS THE THRESHOLD EQUALED OR EXCEEDED?
	BLO	15$		;IF LO NO
;
; THE LIMIT (HARD OR SOFT) HAS ALREADY BEEN REACHED. DISCARD THE PACKET.
;
	MOV	R3,KISAR6	; REMAP PACKET
	MOV	R3,R0		; SET UP FOR DESEC (POINTER)
	MOV	@#140002, R1	; GET LENGTH IN BYTES
	ADD	#77+4,R1	; ACCOUNT FOR LINK AND LENGTH AND TRUNCATION
	ASH	#-6,R1		; CONVERT TO 32 WORD BLOCKS
	CALL	$DESEC		; DEALLOCATE SECONDARY POOL
	BR	37$		;...AND FINISH THE CLEAN UP
;
; THE LIMIT (HARD OR SOFT) HAS NOT BEEN REACHED. UPDATE THE APPROPRIATE
; COUNTER.
;
15$:	INCB	(R2)		;COUNT ANOTHER ERROR
	INCB	(R2)		;ADD ONE MORE FOR OVERFLOW TEST
	BNE	20$		;IF NE NO OVERFLOW
	DECB	(R2)		;NORMALIZE ERROR COUNT
20$:	DECB	(R2)		;...
	CMPB	(R2),	-2(R2)	; LIMIT REACHED?
	BNE	25$		; BR IF NO
	MOV	R3, KISAR6	; MAP BACK TO PACKET
	BISB	#EH$LMR, E$HFLG+140004 ; YES. TELL ERRLOG
25$:	CMP	R2,#ERHC	; HARD ERROR?
	BEQ	30$		; BR IF YES
	MOV	R3,KISAR6	; REMAP PACKET
	CMPB	#E$STMO,E$HTYS+140004	;WAS THIS A TIMEOUT?
	BEQ	27$		;IF EQ - YES, SO CONVERT TO SOFT TIMEOUT
	MOVB	#E$SDVS, E$HTYS+140004 ; SET SOFT ERROR CODE
	BR	30$		; GO TO QUEUE PACKET
27$:	MOVB	#E$STMS,E$HTYS+140004	;MAKE THIS A SOFT TIMEOUT
30$:
	CALL	$QUPK1		; QUEUE THE ERROR PACKET
37$:	MOV	(SP)+,R0	;RESTORE REGISTERS
40$:	MOV	(SP)+,R3	;
	MOV	(SP)+,KISAR6	; RESTORE MAPPING

	.ENDC	; DF E$$LOG


	TST	R4		;DO WE HAVE AN SCB?
	BEQ	50$		;IF EQ NO
	BIC	#S2.EIP,S.ST2(R4)  ;CLEAR ERROR IN PROGRESS FLAG
	CLR	S.EMB(R4)	;SHOW NO ERROR LOG PACKET
50$:	RETURN			;


;+
; **-$CRPK1-CREATE ERROR LOG PACKET
;
; THIS ROUTINE IS CALLED TO CREATE AN ERROR LOG PACKET, EITHER FROM THE
; SEND MESSAGE DIRECTIVE PROCESSING, OR WITHIN THE EXECUTIVE AS PART OF
; THE PROCESSING OF A MEMORY ERROR, NONSENSE INTERRUPT, TIME CHANGE,
; POWER FAIL RECOVERY, OR DEVICE ERROR.
;
; INPUTS:
;
;	R0=PACKET CODE
;	R1=LENGTH OF DATA SUBPACKET
;	R2=CONTROL MASK WORD
;	R3=BEGINNING ADDRESS OF DATA FOR DATA SUBPACKET
;	R4=TCB ADDRESS (FOR TASK SUBPACKET)
;	R5=UCB ADDRESS (FOR DEVICE IDENTIFICATION SUBPACKET)
;
; OUTPUTS:
;
;	R0=UNCHANGED
;	R1=BEGINNING ADDRESS OF DATA SUBPACKET DATA (OFFSET)
;	R2=UNCHANGED
;	R3=BEGINNING ADDRESS OF PACKET (APR VALUE)
;	R4=UNCHANGED
;	R5=UNCHANGED
;
;	C=0 IF A PACKET WAS CREATED
;	C=1 IF A PACKET WAS NOT CREATED
;	KISAR6 MAPS PACKET
;
; OUTPUT PACKET FORMAT:
;
;	+-----------------------------------------------+
;	| RESERVED FOR PACKET LINK WORD			|
;	+-----------------------------------------------+
;	| PACKET LENGTH (LENGTH OF REMAINDER OF PACKET)	|
;	+-----------------------------------------------+
;	| HEADER SUBPACKET				|
;	.						.
;
;	|						|
;	+-----------------------------------------------+
;	| OTHER SUBPACKETS				|
;	.						.
;
;	|						|
;	+-----------------------------------------------+
;-


	.IF DF	E$$LOG

$CRPK1::MOV	R5,-(SP)	;SAVE ALL REGISTERS
	MOV	R4,-(SP)	;...
	MOV	R3,-(SP)	;...
	MOV	R2,-(SP)	;...
	MOV	R1,-(SP)	;...
	MOV	R0,-(SP)	;...

;
; CHECK FOR TYPE OF SUBPACKET.  NOTE THAT THERE WILL ALWAYS BE A
; HEADER SUBPACKET.  AN EXTRA 4 BYTES IS ADDED TO THE LENGTH OF
; THE HEADER SUBPACKET TO ACCOUNT FOR THE PRECEEDING LINK WORD
; AND PACKET LENGTH.

	ROR	R2		;BYPASS HEADER SUBPACKET FLAG
	BCS	5$		;IF CS IT'S THERE
	BGCK$A	BF.ERR,BE.HSP,FATAL ;HEADER SUBPACKET PROBLEM
5$:	MOV	#E$HLEN+4,R1	;ADD IN THE LENGTH OF THE SUBPACKET
	ROR	R2		;CHECK FOR A TASK SUBPACKET
	BCC	10$		;IF CC NO TASK SUBPACKET
	ADD	#E$TLEN,R1	;ADD IN THE SUBPACKET LENGTH
10$:	ROR	R2		;CHECK FOR A DEVICE ID SUBPACKET
	BCC	20$		;IF CC NO DEVICE ID SUBPACKET
	ADD	#E$ILEN,R1	;ADD IN THE SUBPACKET LENGTH
20$:	ROR	R2		;CHECK FOR A DEVICE OP. SUBPACKET
	BCC	30$		;IF CC NO DEVICE OP. SUBPACKET
	ADD	#E$OLEN,R1	;ADD IN THE SUBPACKET LENGTH

;
; CHECK FOR A DEVICE ACTIVITY SUBPACKET
;
; IF THERE IS A DEVICE ACTIVITY SUBPACKET, THERE WILL BE ONE ENTRY IN
; THE SUBPACKET FOR EACH ACTIVE DEVICE (LESS ONE IF THERE IS ALSO A
; DEVICE OPERATION SUBPACKET) PLUS THE PREFIX HEADER LENGTH WORD.
;

30$:	ROR	R2		;CHECK FOR A DEVICE ACTIVITY SUBPACKET
	BCC	60$		;IF CC NO DEVICE ACTIVITY SUBPACKET
	BIT	#SM.DOP,4(SP)	;IS THERE A DEVICE OPERATION SUBPACKET?
	BNE	35$		;IF EQ NO
	CLR	R5		;CLEAR FOR NO UCB
35$:	MOV	R5,R0		;SAVE FOR COMPARISON
	MOV	#$SCDVT,-(SP)	;SETUP FOR COROUTINE CALL
40$:	CALL	@(SP)+		;GET THE NEXT UCB
	BCS	50$		;IF CS NO MORE
	MOV	S.ST2(R4),R3	;COPY STATUS BITS
	COM	R3		;REVERSE THEM
	BIT	#S2.LOG!S2.ACT,R3  ;ACTIVE ERROR LOGGING DEVICE?
	BNE	40$		;IF NE NO
	CMP	R5,R0		;IS THIS OUR UCB?
	BEQ	40$		;IF EQ YES, IGNORE THIS ENTRY
	ADD	#E$ALEN,R1	;YES, COUNT THE I/O
	BR	40$		;LOOP
50$:	ADD	#2,R1		;ADD IN THE LENGTH OF THE PREFIX

;
; CHECK FOR A DATA SUBPACKET
;

60$:	ROR	R2		;CHECK FOR A DATA SUBPACKET
	BCC	70$		;IF CC NO DATA SUBPACKET
	ADD	2(SP),R1	;ADD IN THE LENGTH OF THE SUBPACKET
	ADD	#2,R1		;ADD IN THE PREFIX LENGTH WORD

;
; ALLOCATE THE PACKET
;

70$:	CMP	#512.,R1	;IS THE PACKET A REASONABLE LENGTH?
	BLO	75$		;IF LO NO
;
; CONVERT FROM BYTES TO 32 WORD BLOCKS
;
	MOV	R1,-(SP)	; SAVE BYTE VALUE
	ADD	#77,R1		; COMPENSATE FOR TRUNCATION
	ASH	#-6,R1		; CONVERT
	CALL	$ALSEC		; ALLOCATE SECONDARY POOL
	MOV	(SP)+,R1	; RESTORE BYTE VALUE

	BCC	80$		;IF CC WE GOT IT
75$:	CALLR	PKTXIT		;FAILURE, RESTORE REGISTERS AND EXIT
80$:	MOV	R0,-(SP)	;SAVE THE ADDRESS FOR FUTURE USE
	MOV	14(SP),R5	;RETRIEVE POSSIBLE UCB ADDRESS

;
; CREATE THE PACKET
;
; AT THIS POINT:
;
;	R0=ADDRESS OF ALLOCATED BLOCK (TO BE USED AS APR VALUE)
;	R1=LENGTH OF ALLOCATED BLOCK
;	R2=UNDEFINED
;	R3=UNDEFINED
;	R4=UNDEFINED
;	R5=UCB ADDRESS
;

; AFTER SAVING THE APR6 MAPPING ON THE STACK WE HAVE:
;
;	 0(SP)	SAVED APR6 MAPPING (WILL NOT BE RESTORED)
;	 2(SP)	SAVED APR BIAS OF ALLOCATED BLOCK
;	 4(SP)	SAVED ENTRY CODE
;	 6(SP)	SAVED DATA SUBPACKET LENGTH
;	10(SP)	SAVED CONTROL WORD MASK
;	12(SP)	SAVED DATA ADDRESS
;	14(SP)	SAVED TCB ADDRESS
;	16(SP)	SAVED UCB ADDRESS
;
;

CREPKT:
	MOV	KISAR6,-(SP) 	; SAVE APR6 ON THE STACK
;
	MOV	R0,KISAR6	; MAP TO PACKET
	MOV	#140000,R0	; USE APR 6
	CLR	(R0)+		; SETUP THE LINK WORD
	SUB	#4,R1		;THE DATA LENGTH IS LESS THE HEADER
	MOV	R1,(R0)+	;PUT IN THE PACKET LENGTH
	MOV	#E$HLEN,(R0)+	;PUT IN THE SUBPACKET LENGTH
	MOV	10(SP),R2	;GET THE SAVED CONTROL MASK WORD
	MOV	R2,(R0)+	;INSERT IT INTO THE SUBPACKET
	MOV	#6+<EH$FOR*400>,(R0)+ ;INSERT M-PLUS CODE
	MOV	$SYSID,(R0)+	;INSERT SYSTEM IDENTIFICATION
	MOV	$SYSID+2,(R0)+	;...

;
; INSERT THE FLAGS WORD, THE ENTRY AND ERROR SEQUENCE NUMBERS,
; AS WELL AS THE ENTRY CODE, TIME STAMP, PROCESSOR AND URM.
;

	MOV	#EH$NOR!<<EH$VIR!EH$EXT!EH$COU>*400>,R3	;CREATE FLAGS
	BIT	#HF.QB,$HFMSK	;IS THIS A Q-BUS SYSTEM?
	BEQ	5$		;IF EQ NO, SO GO ON
	BIS	#<EH$QBS*400>,R3;YES, SO SET THE FLAG BIT
5$:	MOV	R3,(R0)+	;NOW PUT IT IN THE SUBPACKET
	INC	$ENTSQ		;COUNT THE NEXT ENTRY
	MOV	$ENTSQ,(R0)+	;WRITE IT
	MOV	$ERRSQ,(R0)+	;PUT IN THE ERROR SEQUENCE COUNT
	MOV	4(SP),(R0)+	;PUT IN THE ENTRY TYPE CODE AND SUBCODE
	MOV	#$TTNS-<6*2>,R3	;GET THE POINTER TO THE SYSTEM TIME
	MOV	#6,R1		;GET THE NUMBER OF PARAMETERS TO INSERT
10$:	MOVB	(R3)+,(R0)+	;INSERT THE ITEM IN THE TIME STAMP
	TSTB	(R3)+		;POINT AT NEXT ITEM
	SOB	R1,10$		;LOOP UNTIL DONE.
	MOVB	$PRMOD,(R0)+	;PUT IN THE PROCESSOR INFORMATION
	CLRB	(R0)+		;CLEAR THE RESERVED BYTE


	.IF DF	M$$PRO

	MOV	@$CPURM,(R0)+	;GET PROCESSOR URM

	.IFF	; DF M$$PRO

	MOV	#1,(R0)+	;ASSUME CPA

	.ENDC	; DF M$$PRO


	ROR	R2		;DISCARD THE FLAG FOR THE HEADER

;
; CREATE THE TASK SUBPACKET
;
;
; AT THIS POINT:
;
;	R0=POINTER TO NEXT FREE ENTRY IN ALLOCATED BLOCK
;	R1=UNDEFINED
;	R2=CONTROL MASK WORD, SHIFTED RIGHT 1
;	R3=UNDEFINED
;	R4=UNDEFINED
;	R5=UCB ADDRESS
;

CRETSK:	ROR	R2		;CHECK THE FLAG FOR TASK SUBPACKET
	BCC	CREDID		;IF CC NO TASK SUBPACKET
	MOV	#E$TLEN,(R0)+	;PUT IN THE SUBPACKET LENGTH
	MOV	14(SP),R1	;GET THE SAVED TCB ADDRESS
	CALL	CRTASP		;CREATE THE TASK SUBPACKET

;
; CREATE THE DEVICE IDENTIFICATION SUBPACKET
;
; AT THIS POINT:
;
;	R0=POINTER TO NEXT FREE ENTRY IN ALLOCATED BLOCK
;	R1=UNDEFINED
;	R2=CONTROL MASK WORD, SHIFTED RIGHT 2
;	R3=UNDEFINED
;	R4=UNDEFINED
;	R5=UCB ADDRESS
;

CREDID:	ROR	R2		;IS THERE A DEVICE ID SUBPACKET?
	BCC	CREDOP		;IF CC NO
	MOV	U.SCB(R5),R4	;RETRIEVE SCB ADDRESS
	MOV	#E$ILEN,(R0)+	;INSERT THE LENGTH OF THE SUBPACKET
	CALL	CRDEVP		;CREATE DEVICE INFORMATION
	BIT	#DV.DIR,U.CW1(R5) ;IS THIS A DIRECTORY DEVICE?
	BEQ	5$		;IF EQ NO, DON'T INTERPRET VCB
	MOV	U.VCB(R5),R3	;GET A POINTER TO THE VCB
	BNE	15$		;IF NE VCB EXISTS
5$:	MOV	#<E$IDEV-E$IVOL>/2,R3  ;GET THE NUMBER OF WORDS TO CLEAR
10$:	CLR	(R0)+		;CLEAR OUT THE VOLUME NAME AND PACK ID.
	SOB	R3,10$		;LOOP UNTIL DONE CLEARING
	BR	30$		;DONE WITH THE VOLUME INFORMATION
15$:	ADD	#V.LABL,R3	;POINT AT THE LABEL
	MOV	#<E$IDEV-E$IVOL>/2,R1  ;GET THE NUMBER OF WORDS TO MOVE
20$:	MOV	(R3)+,(R0)+	;TRANSFER VOLUME NAME AND PACK ID
	SOB	R1,20$		;LOOP UNTIL DONE
	BIT	#DV.SQD,U.CW1(R5)  ;IS THIS A DISK?
	BEQ	30$		;IF EQ YES
	CMP	-(R0),-(R0)	;NO, BACKUP TO PACK SERIAL NUMBER
	CLR	(R0)+		;CLEAR PACK SERIAL NUMBER
	CLR	(R0)+		;...
30$:	MOV	#1,(R0)+	;ALL DEVICES ARE OF TYPE 1
	MOV	U.CW3(R5),(R0)+	;GET LOW ORDER BLOCKS IN DEVICE
	MOVB	U.CW2(R5),(R0)+	;GET HIGH ORDER BLOCKS IN DEVICE
	CLRB	(R0)+		;

;
; INSERT THE I/O COUNT INFORMATION AND CLEAR THEM IF REQUESTED.
; NOTE THAT THIS INFORMATION IS IN SECONDARY POOL AND MAY OR
; MAY NOT BE PRESENT.
;

	MOV	U.UCBX(R5),KISAR6  ;MAP UCB EXTENSION IN SECONDARY POOL
	BEQ	35$		;IF EQ NO EXTENSION
;
; MAP TO UCB EXTENSION, SAVE COUNTS ON THE STACK THEN MAP BACK
; TO ERROR PACKET AND FILL IT IN.
;
	MOV	#IOC+20, R1	; GET END OF I/O COUNTS
	MOV	-(R1),-(SP)	; SAVE THE LOW ORDER
	MOV	-(R1),-(SP)	; SAVE HIGH ORDER CYLINDERS CROSSED COUNT
	MOV	-(R1),-(SP)	; SAVE LOW ORDER
	MOV	-(R1),-(SP)	; SAVE HIGH ORDER BLOCKS TRANSFERED COUNT
	MOV	-(R1),-(SP)	; SAVE SOFT AND HARD ERROR COUNTS
	TST	-(R1)		; BYPASS ERROR LIMITS
	MOV	-(R1),-(SP)	; SAVE I/O COUNT
	MOV	-(R1),-(SP)	;...
	BIT	#SM.ZER,26(SP)	; ZERO THE COUNTS?
	BEQ	33$		; IF EQ NO
	CLR	(R1)+		;CLEAR THE COUNTS
	CLR	(R1)+		;...
	TST	(R1)+		;...
	CLR	(R1)+		;...
	CLR	(R1)+		;...
	CLR	(R1)+		;...
	MOV	U.SCB(R5),R3	; GET THE SCB ADDRESS FOR A MOMENT		;DC430
	BIT	#S2.OPT,S.ST2(R3)	; DEVICE SUPPORT SEEK OPTIMIZATION	;DC430
	BEQ	33$		; IF EQ, NOPE, CONTINUE				;DC430
	CLR	(R1)+		;...
	CLR	(R1)+		;...
33$:	MOV	20(SP),	KISAR6	; REMAP PACKET
	MOV	#7,R3		; MOVE 7 ITEMS TO PACKET
34$:	MOV	(SP)+,(R0)+	; GO
	SOB	R3,34$		;...
	BR	40$		;JOIN COMMON CODE BELOW
35$:	ADD	#16,R0		;UPDATE POINTER. NOTE: A FLAG IS SET BY
				;...CRDEVP TO INDICATE THE DATA IN THE
				;...UCB EXTENSION AREA IS INVALID. IT IS DONE
				;...THERE RATHER THAN HERE FOR GENERALITY AS
				;...OTHER ROUTINES CALL CRDEVP.
40$:	MOV	2(SP), KISAR6	; MAP PACKET

;
; CREATE THE DEVICE OPERATION SUBPACKET
;
; AT THIS POINT:
;
;	R0=POINTER TO NEXT FREE ENTRY IN ALLOCATED BLOCK
;	R1=UNDEFINED
;	R2=CONTROL MASK WORD, SHIFTED RIGHT 3
;	R3=UNDEFINED
;	R4=UNDEFINED
;	R5=UCB ADDRESS
;

CREDOP:	ROR	R2		;CHECK FOR PRESENCE OF SUBPACKET
	BCC	CREIOA		;IF CC NO SUCH SUBPACKET
	MOV	U.SCB(R5),R4	;RETRIEVE SCB ADDRESS
	MOV	#E$OLEN,(R0)+	;INSERT THE SUBPACKET LENGTH
	MOV	S.PKT(R4),R1	;GET THE I/O PACKET POINTER
	MOV	I.TCB(R1),R1	;GET THE TCB POINTER
	CALL	CRTASP		;INSERT THE TASK INFORMATION
	CALL	CRIOPP		;INSERT THE I/O PACKET INFORMATION
	CLR	(R0)+		;NO CURRENT RETRY COUNT

;
; I/O ACTIVITY SUBPACKET
;
; AT THIS POINT:
;
;	R0=POINTER TO NEXT FREE ENTRY IN ALLOCATED BLOCK
;	R1=UNDEFINED
;	R2=CONTROL MASK WORD, SHIFTED RIGHT 4
;	R3=UNDEFINED
;	R4=UNDEFINED
;	R5=UCB ADDRESS
;

CREIOA:	ROR	R2		;CHECK FOR AN I/O ACTIVITY SUBPACKET
	BCC	CREDAT		;IF CC NO I/O ACTIVITY SUBPACKET

;
; THE LENGTH OF THE I/O ACTIVITY SUBPACKET WILL BE COMPUTED WHEN THE
; ENTIRE SUBPACKET HAS BEEN CREATED.  SAVE THE BEGINNING ADDRESS OF
; THE SUBPACKET FOR FUTURE USE.
;

	MOV	R0,-(SP)	;SAVE THE BEGINNING SUBPACKET ADDRESS
	CLR	(R0)+		;GET RID OF ANYTHING IN THE LENGTH WORD
	MOV	R5,R2		;SAVE UCB ADDRESS FOR REFERENCE
	MOV	#$SCDVT,-(SP)	;SETUP FOR THE COROUTINE CALL
10$:	CALL	@(SP)+		;GET THE NEXT DEVICE
	BCS	20$		;IF CS DONE
	MOV	S.ST2(R4),R3	;COPY STATUS BITS
	COM	R3		;TOGGLE THEM
	BIT	#S2.LOG!S2.ACT,R3  ;ACTIVE ERROR LOGGING DEVICE?
	BNE	10$		;IF NE NO
	CMP	R5,R2		;IS THIS OUR UCB?
	BEQ	10$		;IF EQ YES, IGNORE IT
	CALL	CRDEVP		;CREATE THE DEVICE INFORMATION
	MOV	S.PKT(R4),R1	;GET I/O PACKET ADDRESS
	MOV	I.TCB(R1),R1	;GET THE TASK'S TCB ADDRESS
	CALL	CRTASP		;CREATE THE TASK INFORMATION
	TST	-(R0)		;POINT BACK TO THE TI: UNIT NUMBER
	MOVB	(R0),E$ATIU-E$AFNC(R0) ;INSERT THE TI: UNIT NUMBER
	CALL	CRIOPP		;CREATE THE I/O PACKET INFORMATION
	BR	10$		;LOOP UNTIL DONE

20$:	MOV	R0,R2		;COPY THE CURRENT SUBPACKET ADDRESS
	SUB	(SP),R2		;COMPUTE THE SUBPACKET LENGTH
	MOV	R2,@(SP)+	;INSERT THE LENGTH IN THE SUBPACKET PREFIX

;
; CREATE THE DATA SUBPACKET
;
; AT THIS POINT:
;
;	R0=POINTER TO NEXT FREE ENTRY IN ALLOCATED BLOCK
;	R1=UNDEFINED
;	R2=UNDEFINED
;	R3=UNDEFINED
;	R4=UNDEFINED
;	R5=UNDEFINED
;

CREDAT:	BIT	#SM.DAT,10(SP)	;DO WE HAVE A DATA SUBPACKET?
	BEQ	20$		;IF EQ NO
	MOV	6(SP),R3	;GET THE DATA SUBPACKET LENGTH
	MOV	R3,(R0)		;PUT IN THE LENGTH OF THE DATA ITSELF
	ADD	#2,(R0)+	;ADD IN THE SUBPACKET HEADER LENGTH
	BIT	#SM.MBC,10(SP)	;MASSBUS RHBAE REGISTERS PRESENT?
	BEQ	5$		;IF EQ NO
	SUB	#4,R3		;YES, THEY MAY NOT BE CONTIGUOUS
5$:	MOV	R0,-(SP)	;SAVE SUBPACKET DATA ADDRESS
	MOV	14(SP), R2	;GET THE DATA ADDRESS
	BEQ	15$		;IF EQ, NO DATA
	MOV	R3,R0		;GET NUMBER BYTES TO MOVE
	MOV	2(SP),R1	;DATA BUFFER APR BIAS
;
; IF THE DATA BUFFER IS MAPPED THROUGH ANY APR'S BUT 5 OR 6, THE
; MAPPING WILL BE TRANSPARENT TO BLXIO.  HOWEVER, IF IT'S IN APR6,
; WE MUST CONVERT IT TO USE 5 AND IF IT'S IN 5, WE MUST RETRIEVE
; THE SAVED APR5 MAPPING TO PASS TO BLXIO.
;
	CMP	#160000,R2	;IS DATA IN I/O PAGE?
	BLOS	10$		;IF YES, BRANCH
	CMP	#140000,R2	;IS IT LOWER THAT APR6?
	BHI	7$		;SEE IF IT'S IN APR5
	SUB	#20000, R2	;CONVERT APR6 ADDRESS TO APR5
	BR	10$		;AND CONTINUE
7$:	CMP	#120000, R2	;IS THIS IN APR5?
	BHI	10$		;BR IF NOT
;
; WARNING: THIS STATEMENT REACHES OUT OF THIS MODULE'S "KNOWN" STACK AREA
; TO GET THE APR5 MAPPING WHICH WAS SAVED BY ANOTHER MODULE:
;
	MOV	40(SP),R1	;ELSE, GET THE SAVED APR5 MAPPING
10$:	MOV	4(SP),R3	;GET MAPPING TO PACKET
	MOV	(SP),R4		;ADDR OF BUFFER
	CALL	$BLXIO		;MOVE DATA
	MOV	R4,R0		;UPDATE POINTER
	BIT	#SM.MBC,12(SP)	;MASSBUS RHBAE REGISTERS PRESENT?
	BEQ	15$		;IF EQ NO
	MOV	20(SP),R5	;GET UCB ADDRESS
	MOV	U.SCB(R5),R4	;GET SCB ADDRESS
	MOV	S.KRB(R4),R3	;GET CURRENT KRB ADDRESS
	MOV	R3,R2		;COPY KRB ADDRESS
	ADD	K.OFF(R3),R2	;POINT TO UCB TABLE
	MOV	KE.RHB(R2),R2	;RETREIVE RHBAE OFFSET
	MOV	2(SP),KISAR6	;MAP DATA
	ADD	14(SP),R2	;FORM AN I/O PAGE ADDRESS
	MOV	2(R2),-(SP)	;COPY BOTH REGISTERS
	MOV	(R2),-(SP)	;...
	MOV	10(SP),	KISAR6	;REMAP PACKET
	MOV	(SP)+,(R0)+	;MOVE REGISTERS TO PACKET
	MOV	(SP)+,(R0)+	;MOVE REGISTERS TO PACKET
15$:	MOV	(SP)+,R1	;GET SUBPACKET DATA ADDR.
20$:	CLC			;PACKET COULD BE CREATED
	TST	(SP)+		;DISCARD MAPPING TO DATA
	MOV	(SP)+,R3	;RESTORE THE PACKET ADDRESS
PKTXIT:	MOV	(SP)+,R0	;RESTORE THE ENTRY CODE
	INC	(SP)+		;DISCARD THE DATA SUBPACKET LENGTH
	MOV	(SP)+,R2	;RESTORE THE CONTROL MASK WORD
	INC	(SP)+		;DISCARD THE DATA ADDRESS
	MOV	(SP)+,R4	;RESTORE THE TCB ADDRESS
	MOV	(SP)+,R5	;RESTORE THE UCB ADDRESS
	RETURN			;DONE


;+
; **-CRTASP-CREATE TASK INFORMATION
;
;	CREATES THE FOLLOWING INFORMATION IN THE CURRENT SUBPACKET:
;
;	+-----------------------------------------------+
;	| TASK NAME IN RAD50				|
;	|						|
;	+-----------------------------------------------+
;	| TASK UIC					|
;	+-----------------------------------------------+
;	| TASK TI: DEVICE NAME				|
;	+-----------------------+-----------------------+
;	| FLAGS			| TASK TI: UNIT NUMBER	|
;	+-----------------------+-----------------------+
;
;	FLAGS:
;		ET$PRV	TASK IS PRIVILEGED
;		ET$PRI	TERMINAL IS PRIVILEGED
;
; INPUTS:
;	R0=POINTER TO SUBPACKET FOR INSERTION
;	R1=POINTER TO TASK TCB
;
; OUTPUTS:
;	R0=UPDATED
;	R1 AND R3 ARE DESTROYED
;	R4 AND R5 ARE PRESERVED
;-

CRTASP:	SAVNR			;SAVE R4 AND R5
	MOV	T.NAM(R1),(R0)+	;PUT IN THE TASK NAME
	MOV	T.NAM+2(R1),(R0)+  ;...
	MOV	T.PCB(R1),R4	;GET A POINTER TO THE PCB
	BIT	#PS.OUT!PS.CKP,P.STAT(R4) ;TASK IN MEMORY ?
	BEQ	2$		;IF EQ, YES - UIC IS AVAILABLE
	CLR	(R0)+		;OTHERWISE, ASSUME UIC 0,0
	BR	7$		;
2$:				;REFERENCE LABEL


	.IF DF	X$$HDR

	MOV	KISAR6,-(SP)	;SAVE CURRENT APR6 MAPPING
	MOV	P.HDR(R4),R5	;GET A POINTER TO THE HEADER
	BNE	5$		;IF NE IT'S RESIDENT
	MOV	P.REL(R4),KISAR6;SET APR6 MAPPING TO EXTERNAL HEADER
	MOV	#140000,R5	;SET TO MAP APR6
;
;SAVE UIC AND REMAP PACKET AND INSERT UIC IN PACKET
;
5$:	MOV	H.CUIC(R5),R5  ; SAVE THE UIC
	MOV	(SP)+, KISAR6	; RESTORE PACKET MAPPING
	MOV	R5,(R0)+	; INSERT UIC

	.IFF	; DF X$$HDR

	MOV	P.HDR(R4),R4	;GET A POINTER TO THE HEADER
	MOV	H.CUIC(R4),(R0)+;INSERT THE UIC

	.ENDC	; DF X$$HDR


7$:				;REFERENCE LABEL
	MOV	T.UCB(R1),R5	;GET THE TI: UCB POINTER
10$:	MOV	U.RED(R5),R5	;FOLLOW THE REDIRECT POINTER
	CMP	R5,U.RED(R5)	;IS THE DEVICE REDIRECTED?
	BNE	10$		;IF NE YES
	MOV	U.DCB(R5),R3	;GET THE TI: DCB POINTER
	MOV	D.NAM(R3),(R0)+	;INSERT THE DEVICE NAME
	CALL	CALDEV		;CALCULATE DEVICE UNIT #
	CLRB	(R0)		;INITIALIZE THE FLAG BYTE
	BIT	#U2.PRV,U.CW2(R5)  ;IS THE TI: PRIVILEGED?
	BEQ	20$		;IF EQ NO
	BISB	#ET$PRI,(R0)	;MARK THE TI: PRIVILEGED
20$:	BIT	#T3.PRV,T.ST3(R1)  ;IS THE TASK PRIVILEGED?
	BEQ	25$		;IF EQ NO
	BISB	#ET$PRV,(R0)	;MARK THE TASK PRIVILEGED
25$:	TSTB	(R0)+		;POINT PAST THE FLAG ENTRY
	RETURN			;DONE


;+
; **-CRDEVP-CREATE DEVICE INFORMATION
;
;	CREATES THE FOLLOWING INFORMATION IN THE CURRENT SUBPACKET:
;
;	+-----------------------------------------------+
;	| LOGICAL DEVICE NAME MNEMONIC			|
;	+-----------------------+-----------------------+
;	| CONTROLLER NUMBER	| DEVICE UNIT NUMBER	|
;	+-----------------------+-----------------------+
;	| PHYSICAL SUBUNIT #	| PHYSICAL UNIT #	|
;	+-----------------------+-----------------------+
;	| PHYSICAL DEVICE NAME MNEMONIC			|
;	+-----------------------------------------------+
;	| RESERVED		| FLAGS			|
;	+-----------------------+-----------------------+
;
; INPUTS:
;	R0=POINTER TO DATA AREA
;	R4=SCB ADDRESS
;	R5=UCB ADDRESS
;
; OUTPUTS:
;	R0=UPDATED
;	R1 AND R3 ARE DESTROYED
;	R4 AND R5 ARE PRESERVED
;-

CRDEVP:	SAVNR			;SAVE R4 AND R5
	CLR	-(SP)		;CLEAR FLAG WORD
	MOV	U.DCB(R5),R3	;GET A POINTER TO OUR DCB
	TST	U.UCBX(R5)	;DOES THE UCB EXTENSION EXIST?
	BNE	10$		;IF NE - YES
	BIS	#EI$NUX,(SP)	;INDICATE ANY UCB EXTENSION DATA IS INVALID
10$:	MOV	D.NAM(R3),(R0)+	;PUT IN THE LOGICAL DEVICE MNEMONIC
	CALL	CALDEV		;CALCULATE DEVICE UNIT #
	MOV	S.KRB(R4),R3	;GET CURRENT KRB ADDRESS
	BEQ	15$		;IF EQ - NO KRB
	MOVB	K.CON(R3),R3	;GET CONTROLLER INDEX
15$:	ASRB	R3		;MAKE IT A NUMBER
	MOVB	R3,(R0)+	;INSERT CONTROLLER INDEX
	MOVB	U.UNIT(R5),(R0)+;GET THE PHYSICAL UNIT NUMBER
	CLRB	(R0)+		;CLEAR THE SUBUNIT NUMBER
	BITB	#S3.SLV,S.ST3(R4)  ;IS THERE ANY SLAVE UNITS?
	BEQ	20$		;IF EQ NO
	MOVB	U.SNUM(R5),-1(R0)  ;YES, INSERT SUBUNIT NUMBER
	BIS	#EI$SUB,(SP)	;FLAG AS A SUBCONTROLLER DEVICE

;
; GET THE PHYSICAL CONTROLLER NAME BY SCANNING THE CTB LIST.
;

20$:	MOV	#$CTLST,R3	;GET ADDRESS OF CTB LISTHEAD
25$:	MOV	(R3),R3		;GET THE NEXT CTB ADDRESS
	BNE	30$		;IF NE WE GOT ONE
	MOV	U.DCB(R5),R3	;ELSE GET DCB ADDRESS
	MOV	D.NAM(R3),(R0)+	;USE DCB NAME FOR CONTROLLER NAME
	BR	55$		;
30$:	MOV	L.DCB(R3),R1	;GET DCB POINTER FROM CTB
	BITB	#LS.CIN,L.STS(R3)  ;IS THIS A COMMON INTERRUPT CONTROLLER?
	BNE	40$		;IF NE YES, SEARCH TABLE FOR DCB
	CMP	R1,U.DCB(R5)	;IS THIS THE CORRECT CTB?
	BNE	25$		;IF NE NO, LOOP
	BR	50$		;IT MUST BE
40$:	TST	(R1)+		;SKIP COMMON INTERRUPT ADDRESS
45$:	TST	(R1)		;IS THIS THE END OF THE TABLE?
	BEQ	25$		;IF EQ YES
	CMP	(R1)+,U.DCB(R5)	;DOES THE DCB MATCH OUR DCB?
	BNE	45$		;IF NE NO
50$:	MOV	L.NAM(R3),(R0)+	;INSERT PHYSICAL CONTROLLER NAME
55$:	MOV	(SP)+,(R0)+	;SET FLAGS
	RETURN			;


;+
; **-CRIOPP-INSERT I/O PACKET PARAMETERS
;
;	INSERTS THE FOLLOWING I/O PACKET PARAMETERS:
;
;	+-----------------------------------------------+
;	| I/O FUNCTION CODE				|
;	+-----------------------+-----------------------+
;	| RESERVED		| FLAGS			|
;	+-----------------------+-----------------------+
;	| TRANSFER OPERATION ADDRESS			|
;	|						|
;	+-----------------------------------------------+
;	| TRANSFER OPERATION BYTE COUNT			|
;	+-----------------------------------------------+
;
; INPUTS:
;	R0=POINTER TO SUBPACKET DATA
;	R4=SCB ADDRESS
;	R5=UCB ADDRESS
;
; OUTPUTS:
;	R0=UPDATED
;	R1 AND R3 ARE DESTROYED
;	R4 AND R5 ARE PRESERVED
;-

CRIOPP:	MOV	R2,-(SP)	;SAVE REGISTER
	MOV	S.PKT(R4),R1	;GET I/O PACKET ADDRESS
	MOV	I.FCN(R1),R3	;GET FUNCTION CODE
	MOV	R3,(R0)+	;INSERT IT
	CLR	(R0)		;SETUP FOR THE FLAGS

;
; OBTAIN A MASK BIT FOR THE I/O FUNCTION CODE
;

	MOV	U.DCB(R5),R1	;GET THE DCB POINTER
	ADD	#D.MSK+2,R1	;AND POINT TO THE FUNCTION MASK
	CLRB	R3		;CLR MODIFIER FLAGS
	SWAB	R3		;PUT FUNCTION CODE IN LOW BYTE
	CMP	R3,#15.		;IS THE FUNCTION IN THE SECOND MASKS?
	BLOS	10$		;IF LOS FUNCTION IN FIRST MASK
	SUB	#16.,R3		;NORMALIZE THE FUNCTION CODE
	ADD	#8.,R1		;POINT TO THE SECOND SET
10$:	ASL	R3		;MAKE FUNCTION CODE A WORD INDEX
	MOV	$BTMSK(R3),R3	;GET BIT THAT CORRESPONDS TO FUNCTION CODE

;
; SEE IF THE FUNCTION IS OTHER THAN A TRANSFER FUNCTION
;

	BIT	R3,(R1)+	;IS IT A CONTROL FUNCTION?
	BNE	20$		;IF NE YES
	BIT	R3,(R1)+	;IS IT A NOOPED FUNCTION?
	BNE	20$		;IF NE YES
	BIT	R3,(R1)+	;IS IT AN ACP FUNCTION?
	BNE	20$		;IF NE YES
	BIS	#EO$TRA,(R0)	;FLAG AS A TRANSFER FUNCTION

;
; INSERT THE OTHER FLAGS
;

20$:	BITB	#UC.NPR,U.CTL(R5) ;IS IT A DMA DEVICE?
	BEQ	40$		;IF EQ NO
	BIS	#EO$DMA,(R0)	;FLAG AS A DMA DEVICE
	MOV	S.KRB(R4),R3	;GET CURRENT KRB ADDRESS
	BIT	#KS.MBC!KS.EXT,K.STS(R3)  ;22-BIT ADDRESSING DEVICE?
	BEQ	35$		;IF EQ NO
	BIS	#EO$EXT,(R0)	;FLAG AS EXTENDED ADDRESSING DEVICE
35$:	BITB	#S3.SIP,S.ST3(R4)  ;IS THE DEVICE POSITIONING?
	BEQ	40$		;IF EQ NO
40$:    MOV     S.PKT(R4),R2    ; GET THE POINTER TO THE I/O PACKET
	BIT     #1,I.IOSB+4(R2) ; TEST IF THIS IS AN INTERNAL I/O PACKET
	BEQ     41$		; IF EQ NO
	BIS     #EO$IIO,(R0)    ; THEN SET THE BIT TO INDICATE IT
41$:    MOV     (R0)+,R1	; GET COPY OF FLAG WORD
	BIT	#EO$EXT,R1	;DO WE HAVE AN EXTENDED ADDRESS?
	BNE	70$		;IF NE YES
	BIT	#EO$DMA,R1	;IS THIS A DMA DEVICE?
	BEQ	90$		;IF EQ NO

;
; INSERT THE TRANSFER OPERATION ADDRESS AND LENGTH
;

	ADD	K.OFF(R3),R3	;POINT TO UMR AREA+2
	MOV	-(R3),2(R0)	;INSERT LOW BITS OF ADDRESS
	MOVB	-(R3),(R0)+	;INSERT HIGH BITS OF ADDRESS
	CLRB	(R0)+		;FORGET ANY GARBAGE
	TST	(R0)+		;POINT PAST LOW BITS
	BR	100$		;
70$:	MOVB	U.BUF+1(R5),(R0);ASSUME HIGH BITS ARE IN UCB
	BIT	#KS.EXT,K.STS(R3)  ;IS THIS A 22-BIT UNIBUS DEVICE?
	BEQ	80$		;IF EQ NO
	MOV	S.PKT(R4),R2	;GET I/O PACKET ADDRESS
	MOV	I.PRM+6(R2),(R0);GET HIGH BITS OF ADDRESS
80$:	BIC	#^C<377>,(R0)+	;CLEAR GARBAGE
	BR	95$		;GO GET LOW BITS
90$:	MOV	U.BUF(R5),(R0)+	;STORE HIGH BITS OF ADDRESS
95$:	MOV	U.BUF+2(R5),(R0)+  ;STORE LOW BITS OF ADDRESS
100$:	MOV	U.CNT(R5),(R0)+	;MOVE IN THE BYTE COUNT
	MOV	(SP)+,R2	;RESTORE REGISTER
	RETURN			;

;+
; **-CALDEV-CALCULATE DEVICE UNIT NUMBER
;
; THIS ROUTINE WILL CALCULATE THE LOGICAL UNIT NUMBER FOR
; THE GIVEN UCB.
;
; INPUTS:
;	R0=POINTER TO PACKET DATA
;	R3=DCB ADDRESS
;	R5=UCB ADDRESS
;
; OUTPUTS:
;	UNIT NUMBER STORED IN NEXT PACKET BYTE.
;-

CALDEV:	SAVNR			;SAVE R4 AND R5
	SUB	D.UCB(R3),R5	;COMPUTE RELATIVE UCB ADDRESS
	CLR	R4		;GET READY FOR THE DIVIDE
	DIV	D.UCBL(R3),R4	;COMPUTE REALTIVE UNIT NUMBER
	ADD	D.UNIT(R3),R4	;COMPUTE ABSOLUTE UNIT NUMBER
	MOVB	R4,(R0)+	;STORE IN ERROR PACKET
	RETURN			;


;+
; **-$CREQ1-CREATE AND QUEUE ERROR LOG PACKET
;
; THIS ROUTINE CREATES AND QUEUES ERROR LOG PACKET.  IT USES $CRPK1
; AND $QUPK1.  IT'S INPUT IS THE SAME AS THE INPUT TO $CRPK1 AND IT'S
; OUTPUT IS THE SAME AS THAT FROM $QUPK1.  IF THE PACKET CANNOT BE
; CREATED, $QUPKT IS NOT CALLED AND A RETURN IS MADE WITH CARRY SET.
; KISAR6 MAPPING IS PRESERVED.
;
;-
$CREQ1::
	MOV	KISAR6,-(SP)	; SAVE MAPPING
	CALL	$CRPK1		; CREATE THE PACKET
	MOV	(SP)+,KISAR6	; RESTORE MAPPING
	BCC	$QUPK1		; IF WE GOT PACKET, QUEUE IT
	RETURN			; ELSE, RETURN WITH CARRY SET


;+
; **-$QUPK1-QUEUE ERROR LOG PACKET
;
; THIS ROUTINE IS CALLED TO QUEUE AN ERROR LOG PACKET.  IF THERE IS NO
; OTHER PACKET IN THE QUEUE, THE ERROR LOGGER IS REQUESTED WITH A DELAY.
; IF THERE IS ANOTHER PACKET ALREADY IN THE QUEUE, THE ERROR LOGGER IS
; REQUESTED IMMEDIATLY.
;
; INPUTS:
;
;	R3=POINTER TO PACKET FOR INSERTION IN QUEUE (APR VALUE)
;
; OUTPUTS:
;
;	R4 AND R5 ARE PRESERVED
;	ALL OTHER REGISTERS ARE DESTROYED
;-

$QUPK1::SAVNR			;SAVE R5 AND R4
	MOV	R3,R1		;COPY THE POINTER TO THE PACKET
	MOV	$ERRPT,R5	;SAVE FOR USE WHEN REQUESTING THE TASK
	BEQ	40$		;IF EQ NO ERROR LOG TASK
	MOV	#$ERHEA,R0	;GET A POINTER TO THE QUEUE LIST HEAD
	CALL	$QSPIF		;INSERT THE ENTRY FIFO IN THE QUEUE (2ND POOL)
	CMP	(R0)+,(R0)	;IS THIS THE FIRST ENTRY IN THE QUEUE?
	BNE	20$		;IF NE NO
	MOV	KISAR6,-(SP)	; SAVE APR6 MAPPING
	MOV	R1,KISAR6	; MAP PACKET
	BIT	#SM.CMD,E$HSBF+140004  ;IS THIS A COMMAND PACKET?
	BNE	10$		; IF NO YES
	MOV	(SP)+,KISAR6	; RESTORE MAPPING
	MOV	#C.LGTH,R1	;SIZE OF A CLOCK QUEUE ENTRY
	CALL	$ALOCB		;ALLOCATE THE CORE BLOCK
	BCS	20$		;IF CS FAILURE, TRY IMMEDIATE REQUEST
	CLR	C.UIC(R0)	;INDICATE DEFAULT UIC


	.IF DF	A$$CNT

	CLR	C.UAB(R0)	;BILL TASK TO SYSTEM

	.ENDC	; DF A$$CNT


	CLR	R1		;HIGH TIME = 0
	MOV	#ERRTIM,R2	;LOW TIME
	MOV	#C.SSHT,R4	;SINGLE SHOT TASK REQUEST
	CALLR	$CLINS		;INSERT THE ENTRY IN THE QUEUE

;
; THERE IS ANOTHER PACKET IN THE QUEUE, SO IMMEDIATLY REQUEST
; THE ERROR LOGGER.
;

10$:	MOV	(SP)+,KISAR6	; RESTORE MAPPING
20$:	MOV	R5,R0		;COPY THE ERROR LOG TCB
	TST	T.STAT(R0)	;IS IT ALREADY RUNNING?
	BPL	30$		;IF PL YES, DON'T REQUEST IT
	CLR	R1		;INDICATE DEFAULT UIC
	CALLR	$TSKRT		;REQUEST THE TASK

;
; THE ERROR LOG TASK IS ALREADY RUNNING, SO DISMISS THE REQUEST
;

30$:	RETURN			;EXIT

;
; THE ERROR LOG TASK HAS BEEN REMOVED.  DISCARD THE QUEUED ENTRY
;

40$:	MOV	R1,R0		;COPY THE ERROR LOG PACKET POINTER
	MOV	KISAR6,	-(SP)	; SAVE MAPPING
	MOV	R1,KISAR6	; MAP TO PACKET
	MOV	@#140002,R1	; GET SIZE OF PACKET IN BYTES
	ADD	#77+4,R1	; ACCOUNT FOR LINK + LENGTH + TRUNCATION
	ASH	#-6,R1		; CONVERT TO 32 WORD BLOCKS
	MOV	(SP)+,KISAR6	; RESTORE MAPPING
	CALLR	$DESEC		; DEALLOCATE SECONDARY POOL


;+
; **-$QRMV1-REMOVE ENTRY FROM ERROR LOG QUEUE
;
; THIS ROUTINE REMOVES AN ENTRY FROM THE ERROR LOG QUEUE AND TRANSFERS
; IT INTO A USER BUFFER.
;
; INPUTS:
;
;	R4=LENGTH OF USER BUFFER
;	R5=ADDRESS OF USER BUFFER
;
; OUTPUTS:
;
;	R1=LENGTH OF PACKET
;	R4=UNCHANGED
;	R5=UNCHANGED
;
;	C=0 PACKET WAS REMOVED SUCCESSFULLY
;	C=1 NO PACKET TO REMOVE OR PACKET TOO LONG.  IF R1<>0 THE
;	    PACKET WAS TOO LONG, AND R1 CONTAINS THE PACKET LENGTH.
;-

$QRMV1::SAVNR			; SAVE R4 AND R5
	CLR	R1		; SAY THE PACKET HAS LENGTH OF ZERO
	MOV	#$ERHEA,R0	;GET THE QUEUE POINTER
	CALL	$QSPRF		; REMOVE PACKET FROM QUEUE
	BCS	30$		;IF CS NO SUCH PACKET
	MOV	KISAR6,-(SP)	; SAVE MAPPING
	MOV	R1,KISAR6	; MAP TO PACKET - VALUE CAME FROM QSPRF
	MOV	@#140002,R0	; GET SIZE OF PACKET
	MOV	(SP)+,KISAR6	; RESTORE MAPPING
	MOV	R0,-(SP)	; SAVE SIZE
	MOV	R4,-(SP)	; SAVE USER BUFFER SIZE
	MOV	R5,R4		; USER BUFFER ADDRESS
	CMP	R0,(SP)+	; IS THE PACKET TOO LONG?
	BHI	20$		;IF HI PACKET IS TOO LONG
;
; PREPARE FOR $BLXIO.. INPUT IS R0= #BYTES, R1=SOURCE APR5 BIAS
; R2=SOURCE DISPLACEMENT, R3=DESTINATION APR6 BIAS, R4=DEST. DISPL.
; OUTPUT FROM BLXIO IS:  R0 ALTERED, R1,R3 PRESERVED, R2 AND R4 POINT
; TO LAST BYTE OF SOURCE AND DEST. +1
;
	MOV	#120004,R2	; SKIP LINK AND LENGTH WORDS
	MOV	KISAR6,R3	; PRIV.TASK'S APR6
	CALL	$BLXIO		; MOVE THE BUFFER
20$:	MOV	R1,-(SP)	; SWAP R0 AND R1 FOR DESEC
	MOV	(SP)+,R0	;...
	MOV	(SP)+,R1	;...
	MOV	R1,-(SP)	; SAVE SIZE IN BYTES FOR OUTPUT
	ADD	#77+4,R1	; ACCOUNT FOR LENGTH, LINK AND TRUNCATION
	ASH	#-6,R1		; CONVERT TO BLOCKS
	CALL	$DESEC		; DEALLOCATE PACKET

	MOV	(SP)+,R1	;RESTORE THE PACKET LENGTH
	DEC	R4		;ADJUST SO THAT IF:
				; R4>R5 WE TRANSFERRED DATA
				; R4<R5 WE DID NOT TRANSFER DATA
	CMP	R4,R5		;DID WE TRANSFER ANYTHING?
				; THE C BIT IS SET IF R4 LO R5, WHICH

				; INDICATES WE DID NOT TRANSFER DATA.
30$:	RETURN			;DONE

	.ENDC	; DF E$$LOG

	.END